home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH13 / SRC / OBJPGONR.CLS < prev    next >
Encoding:
Text File  |  1996-05-04  |  8.7 KB  |  299 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjPolygon"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. ' The plane that contains the polygon.
  11. Private plane As New ObjPlane
  12.  
  13. Private NumPts As Integer   ' Number of points.
  14. Private Points() As Point3D ' Data points.
  15.  
  16. ' ************************************************
  17. ' Return the red, green, and blue components of
  18. ' the surface at the hit position.
  19. ' ************************************************
  20. Public Sub HitColor(depth As Integer, Objects As Collection, r As Integer, G As Integer, B As Integer)
  21.     plane.HitColor depth, Objects, r, G, B
  22. End Sub
  23.  
  24. ' ************************************************
  25. ' Return true if the point lies within the
  26. ' polygon.
  27. ' ************************************************
  28. Function PointInside(x As Single, y As Single, z As Single) As Boolean
  29. Dim i As Integer
  30. Dim xok As Boolean
  31. Dim yok As Boolean
  32. Dim zok As Boolean
  33.  
  34.     ' See in which coordinates the points differ.
  35.     ' X coordinates.
  36.     For i = 2 To NumPts
  37.         If Points(i - 1).trans(1) <> Points(i).trans(1) _
  38.             Then Exit For
  39.     Next i
  40.     xok = (i <= NumPts)
  41.     
  42.     ' Y coordinates.
  43.     For i = 2 To NumPts
  44.         If Points(i - 1).trans(2) <> Points(i).trans(2) _
  45.             Then Exit For
  46.     Next i
  47.     yok = (i <= NumPts)
  48.     
  49.     ' Z coordinates.
  50.     For i = 2 To NumPts
  51.         If Points(i - 1).trans(3) <> Points(i).trans(3) _
  52.             Then Exit For
  53.     Next i
  54.     zok = (i <= NumPts)
  55.     
  56.     If xok And yok Then
  57.         PointInside = PointInsideXY(x, y)
  58.     ElseIf yok And zok Then
  59.         PointInside = PointInsideYZ(y, z)
  60.     ElseIf xok And zok Then
  61.         PointInside = PointInsideXZ(x, z)
  62.     Else
  63.         PointInside = False
  64.     End If
  65. End Function
  66.  
  67. ' ************************************************
  68. ' Compute the distance from point (px, py, pz)
  69. ' along vector <vx, vy, vz> to the polygon.
  70. ' ************************************************
  71. Public Function RayDistance(px As Single, py As Single, pz As Single, Vx As Single, Vy As Single, Vz As Single) As Single
  72. Dim dist As Single
  73. Dim x As Single
  74. Dim y As Single
  75. Dim z As Single
  76. Dim dx As Single
  77. Dim dy As Single
  78. Dim dz As Single
  79.  
  80.     ' Find the distance to the plane.
  81.     dist = plane.RayDistance(px, py, pz, Vx, Vy, Vz)
  82.     
  83.     ' If there is no good intersection with the
  84.     ' plane, there's none with the polygon.
  85.     If dist >= INFINITY Then
  86.         RayDistance = INFINITY
  87.         Exit Function
  88.     End If
  89.  
  90.     ' See if the point of intersection lies within
  91.     ' the polygon.
  92.     
  93.     ' Get the hit location.
  94.     plane.HitLocation x, y, z
  95.  
  96.     ' See if the point lies inside the projection
  97.     ' onto the X-Y plane.
  98.     If Not PointInside(x, y, z) Then
  99.         RayDistance = INFINITY
  100.         Exit Function
  101.     End If
  102.     
  103.     RayDistance = dist
  104. End Function
  105.  
  106.  
  107. ' ************************************************
  108. ' Return true if the point projection lies within
  109. ' this polygon's projection onto the X-Z plane.
  110. ' ************************************************
  111. Function PointInsideYZ(y As Single, z As Single) As Boolean
  112. Dim i As Integer
  113. Dim theta1 As Double
  114. Dim theta2 As Double
  115. Dim dtheta As Double
  116. Dim dy As Double
  117. Dim dz As Double
  118. Dim angles As Double
  119.  
  120.     dy = Points(NumPts).trans(2) - y
  121.     dz = Points(NumPts).trans(3) - z
  122.     theta1 = Arctan2(CSng(dy), CSng(dz))
  123.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  124.     For i = 1 To NumPts
  125.         dy = Points(i).trans(2) - y
  126.         dz = Points(i).trans(3) - z
  127.         theta2 = Arctan2(CSng(dy), CSng(dz))
  128.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  129.         dtheta = theta2 - theta1
  130.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  131.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  132.         angles = angles + dtheta
  133.         theta1 = theta2
  134.     Next i
  135.     
  136.     PointInsideYZ = (Abs(angles) > 0.001)
  137. End Function
  138.  
  139. ' ************************************************
  140. ' Return true if the point projection lies within
  141. ' this polygon's projection onto the X-Y plane.
  142. ' ************************************************
  143. Function PointInsideXZ(x As Single, z As Single) As Boolean
  144. Dim i As Integer
  145. Dim theta1 As Double
  146. Dim theta2 As Double
  147. Dim dtheta As Double
  148. Dim dx As Double
  149. Dim dz As Double
  150. Dim angles As Double
  151.  
  152.     dx = Points(NumPts).trans(1) - x
  153.     dz = Points(NumPts).trans(3) - z
  154.     theta1 = Arctan2(CSng(dx), CSng(dz))
  155.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  156.     For i = 1 To NumPts
  157.         dx = Points(i).trans(1) - x
  158.         dz = Points(i).trans(3) - z
  159.         theta2 = Arctan2(CSng(dx), CSng(dz))
  160.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  161.         dtheta = theta2 - theta1
  162.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  163.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  164.         angles = angles + dtheta
  165.         theta1 = theta2
  166.     Next i
  167.     
  168.     PointInsideXZ = (Abs(angles) > 0.001)
  169. End Function
  170.  
  171. ' ************************************************
  172. ' Return true if the point projection lies within
  173. ' this polygon's projection onto the X-Y plane.
  174. ' ************************************************
  175. Function PointInsideXY(x As Single, y As Single) As Boolean
  176. Dim i As Integer
  177. Dim theta1 As Double
  178. Dim theta2 As Double
  179. Dim dtheta As Double
  180. Dim dx As Double
  181. Dim dy As Double
  182. Dim angles As Double
  183.  
  184.     dx = Points(NumPts).trans(1) - x
  185.     dy = Points(NumPts).trans(2) - y
  186.     theta1 = Arctan2(CSng(dx), CSng(dy))
  187.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  188.     For i = 1 To NumPts
  189.         dx = Points(i).trans(1) - x
  190.         dy = Points(i).trans(2) - y
  191.         theta2 = Arctan2(CSng(dx), CSng(dy))
  192.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  193.         dtheta = theta2 - theta1
  194.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  195.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  196.         angles = angles + dtheta
  197.         theta1 = theta2
  198.     Next i
  199.     
  200.     PointInsideXY = (Abs(angles) > 0.001)
  201. End Function
  202.  
  203. ' ***********************************************
  204. ' Define the plane that contains the polygon.
  205. ' ***********************************************
  206. Public Sub DefinePlane()
  207. Dim Ax As Single
  208. Dim Ay As Single
  209. Dim Az As Single
  210. Dim Bx As Single
  211. Dim By As Single
  212. Dim Bz As Single
  213. Dim nx As Single
  214. Dim ny As Single
  215. Dim nz As Single
  216.  
  217.     Ax = Points(2).coord(1) - Points(1).coord(1)
  218.     Ay = Points(2).coord(2) - Points(1).coord(2)
  219.     Az = Points(2).coord(3) - Points(1).coord(3)
  220.     Bx = Points(3).coord(1) - Points(2).coord(1)
  221.     By = Points(3).coord(2) - Points(2).coord(2)
  222.     Bz = Points(3).coord(3) - Points(2).coord(3)
  223.     m3Cross nx, ny, nz, Ax, Ay, Az, Bx, By, Bz
  224.     plane.Initialize _
  225.         Points(1).coord(1), _
  226.         Points(1).coord(2), _
  227.         Points(1).coord(3), _
  228.         nx, ny, nz
  229. End Sub
  230.  
  231.  
  232. ' ************************************************
  233. ' Add one or more points to the polygon.
  234. ' ************************************************
  235. Public Sub AddPoint(ParamArray coord() As Variant)
  236. Dim num_pts As Integer
  237. Dim i As Integer
  238. Dim pt As Integer
  239.  
  240.     num_pts = (UBound(coord) + 1) \ 3
  241.     ReDim Preserve Points(1 To NumPts + num_pts)
  242.  
  243.     pt = 0
  244.     For i = 1 To num_pts
  245.         Points(NumPts + i).coord(1) = coord(pt)
  246.         Points(NumPts + i).coord(2) = coord(pt + 1)
  247.         Points(NumPts + i).coord(3) = coord(pt + 2)
  248.         Points(NumPts + i).coord(4) = 1#
  249.         pt = pt + 3
  250.     Next i
  251.  
  252.     NumPts = NumPts + num_pts
  253. End Sub
  254.  
  255.  
  256.  
  257. ' ************************************************
  258. ' Set constants for reflection.
  259. ' ************************************************
  260. Sub SetKr(r As Single, G As Single, B As Single)
  261.     plane.SetKr r, G, B
  262. End Sub
  263. ' ************************************************
  264. ' Set constants for diffuse reflection.
  265. ' ************************************************
  266. Sub SetKd(r As Single, G As Single, B As Single)
  267.     plane.SetKd r, G, B
  268. End Sub
  269.  
  270. ' ************************************************
  271. ' Set constants for ambient light.
  272. ' ************************************************
  273. Sub SetKa(r As Single, G As Single, B As Single)
  274.     plane.SetKa r, G, B
  275. End Sub
  276. ' ************************************************
  277. ' Set N and Ks for specular reflection.
  278. ' ************************************************
  279. Sub SetSpec(n As Single, S As Single)
  280.     plane.SetSpec n, S
  281. End Sub
  282.  
  283. ' ************************************************
  284. ' Apply a transformation matrix to the object.
  285. ' ************************************************
  286. Public Sub Apply(M() As Single)
  287. Dim i As Integer
  288.  
  289.     For i = 1 To NumPts
  290.         m3Apply Points(i).coord, M, Points(i).trans
  291.     Next i
  292.     plane.Apply M
  293. End Sub
  294.  
  295.  
  296.  
  297.  
  298.  
  299.